home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / bonus.arc / RPOLY.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1985-10-02  |  1.7 KB  |  63 lines
  1. ;
  2. ;       Refinement of a random polygon by iterative replacement of
  3. ;       its vertices by the midpoints of its edges.  This miraculously
  4. ;       transforms most random polygons into an ellipse-shaped convex
  5. ;       polygon.
  6. ;
  7. ;       Written by Kelvin R. Throop in October 1985
  8. ;
  9. ;       Based on the technique described in Philip J. Davis,
  10. ;       "Circulant Matrices", Wiley 1979.
  11. ;
  12.  
  13. (defun drawpoly (p)
  14.         (setq dp p)
  15.         (setq dl (length p))
  16.         (command "pline")
  17.         (repeat dl
  18.            (command (car dp))
  19.            (setq dp (cdr dp))
  20.         )
  21.         (command "c")
  22. )
  23.  
  24. (defun C:RPOLY ()
  25.         (setvar "cmdecho" 0)
  26.         (setq cycno 0)
  27.         (setq pl nil)
  28.         (while (setq p (getpoint "Next point: "))
  29.            (setq pl (cons p pl))
  30.         )
  31.         (setvar "blipmode" 0)
  32.         (setq pvert (length pl))
  33.  
  34.         (drawpoly pl)
  35.  
  36.         (while (setq cyc (getint "Cycle count: "))
  37.            (repeat cyc
  38.               (setq plast (nth (1- pvert) pl))
  39.               (setq pn nil)
  40.               (setq pe pl)
  41.               (repeat pvert
  42.                  (setq pc (car pe))
  43.                  (setq pe (cdr pe))
  44.                  (setq pn (cons (list (/ (+ (car pc) (car plast)) 2)
  45.                                       (/ (+ (cadr pc) (cadr plast)) 2))
  46.                                 pn)
  47.                  )
  48.                  (setq plast pc)
  49.               )
  50.               (setq pl pn)
  51.               (setq cycno (1+ cycno))
  52.               (princ "Cycle ")
  53.               (princ cycno)
  54.               (terpri)
  55.            )
  56.            (command "erase" "l" "")
  57.            (drawpoly pn)
  58.            (command "zoom" "e")
  59.         )
  60.         (setvar "cmdecho" 1)
  61.         (setvar "blipmode" 1)
  62. )
  63.